home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
iconal2a
/
colbarmo.bas
< prev
next >
Wrap
BASIC Source File
|
1999-10-13
|
6KB
|
163 lines
Attribute VB_Name = "ColBarModule"
Option Explicit
Public Inp1, DefInp As String
Public xx%, Idx%, IconIdx%
Public Temp$, IBpath$, Inp$, Mess$
Public Message(2) As Boolean
Public r2, r3, g2, g3, b2, b3 As Integer
Public Sub MBox(MObj As Form, Mtxt As String, Mbut0 As String, Mbut1 As String, Mbut2 As String, Micon As Integer, Mtitle As String, MR As Integer, MG As Integer, MB As Integer, Mfont1 As String, Mfont2 As String, MposX As Integer, MposY As Integer)
' 1 = question
' 2 = info
' 3 = exlamation
' 4 = critical
' 5 = disk
' 6 = folder
' 7 = printer
' 8 = write
' 9 = trash
Message(0) = False
Message(1) = False
Message(2) = False
With MObj
.Label2.Width = 3300
r2 = MR + 50: If r2 > 255 Then r2 = 255
g2 = MG + 50: If g2 > 255 Then g2 = 255
b2 = MB + 50: If b2 > 255 Then b2 = 255
r3 = MR - 50: If r3 < 0 Then r3 = 0
g3 = MG - 50: If g3 < 0 Then g3 = 0
b3 = MB - 50: If b3 < 0 Then b3 = 0
.Label2.BackColor = RGB(MR, MG, MB)
.Label3.BackColor = RGB(r3, g3, b3)
.Picture1.BackColor = RGB(MR, MG, MB)
.Pic1(0).BackColor = RGB(MR, MG, MB)
.Pic1(1).BackColor = RGB(MR, MG, MB)
.Pic1(2).BackColor = RGB(MR, MG, MB)
.Label1(0).BackColor = RGB(MR, MG, MB)
.Label1(1).BackColor = RGB(MR, MG, MB)
.Label1(2).BackColor = RGB(MR, MG, MB)
.Label1(0).ForeColor = RGB(MR Xor 255, MG Xor 255, MB Xor 255)
.Label1(1).ForeColor = RGB(MR Xor 255, MG Xor 255, MB Xor 255)
.Label1(2).ForeColor = RGB(MR Xor 255, MG Xor 255, MB Xor 255)
.Label2.ForeColor = RGB(MR Xor 255, MG Xor 255, MB Xor 255)
.Label3.ForeColor = RGB(r2, g2, b2)
MObj.BackColor = RGB(MR, MG, MB)
Dim qq As Integer
For qq = 0 To 2
.Label1(qq).Move 1, 1, .Pic1(qq).ScaleWidth - 2, .Pic1(qq).ScaleHeight - 2
.Pic1(qq).Line (0, 0)-(.Pic1(qq).ScaleWidth - 1, .Pic1(qq).ScaleHeight - 1), RGB(r2, g2, b2), B
.Pic1(qq).Line (0, .Pic1(qq).ScaleHeight - 1)-(.Pic1(qq).ScaleWidth - 1, .Pic1(qq).ScaleHeight - 1), RGB(r3, g3, b3)
.Pic1(qq).Line (.Pic1(qq).ScaleWidth - 1, .Pic1(qq).ScaleHeight - 1)-(.Pic1(qq).ScaleWidth - 1, 0), RGB(r3, g3, b3)
Next qq
MObj.Cls
.Label2.Caption = Mtxt
.Label3.Font = Mfont1
.Label1(0).Font = Mfont1
.Label1(1).Font = Mfont1
.Label1(2).Font = Mfont1
.Label2.Font = Mfont2
MObj.Move MposX, MposY, .Label2.Width + 1125, .Label2.Height + 1140
If .Label2.Width + 1125 < 4500 Then MObj.Width = 4500
.Label3.Move 45, 45, MObj.Width - 90, 300
.Label3.Caption = " " & Mtitle
.Label1(0).Caption = Mbut0
.Label1(1).Caption = Mbut1
.Label1(2).Caption = Mbut2
.Pic1(0).Top = MObj.Height - .Pic1(0).Height - 90
.Pic1(1).Top = MObj.Height - .Pic1(0).Height - 90
.Pic1(2).Top = MObj.Height - .Pic1(0).Height - 90
.Picture1.Top = (MObj.Height / 2) - (.Picture1.Height / 2)
.Picture1.Left = MObj.Width - 630
.Picture1.Picture = .ImageList1.ListImages(Micon).Picture
.Pic1(1).Visible = False
.Pic1(2).Visible = False
.Pic1(0).Left = (MObj.Width / 2) - (.Pic1(0).Width / 2)
If Mbut1 <> "" Then .Pic1(1).Visible = True
If Mbut2 <> "" Then .Pic1(2).Visible = True
If Mbut1 <> "" And Mbut2 <> "" Then
.Pic1(0).Left = (MObj.Width / 2) - .Pic1(0).Width - (.Pic1(1).Width / 2) - 45
.Pic1(1).Left = (MObj.Width / 2) - (.Pic1(1).Width / 2)
.Pic1(2).Left = (MObj.Width / 2) + (.Pic1(1).Width / 2) + 45
End If
If Mbut1 <> "" And Mbut2 = "" Then
.Pic1(0).Left = (MObj.Width / 2) - .Pic1(0).Width - 23
.Pic1(1).Left = (MObj.Width / 2) + 23
End If
MObj.Line (15, 15)-(MObj.Width - 30, MObj.Height - 30), RGB(r2, g2, b2), B
MObj.Line (15, MObj.Height - 30)-(MObj.Width - 30, MObj.Height - 30), RGB(r3, g3, b3)
MObj.Line (MObj.Width - 30, MObj.Height - 30)-(MObj.Width - 30, 30), RGB(r3, g3, b3)
MObj.Line (30, .Label3.Top + .Label3.Height)-(MObj.Width - 30, .Label3.Top + .Label3.Height), RGB(r3, g3, b3)
MObj.Line (30, .Label3.Top + .Label3.Height + 15)-(MObj.Width - 30, .Label3.Top + .Label3.Height + 15), RGB(r2, g2, b2)
End With
MObj.Show 1
End Sub
Public Sub InpBox(InpObj As Object, InpPrompt As String, Inp As String, InpTitle As String, InpFont As String, InpX As Integer, InpY As Integer)
With InpObj
InpObj.Cls
Inp1 = ""
.Text1.BackColor = RGB(210, 255, 255)
.Text1.ForeColor = RGB(0, 0, 128)
.Text1.FontBold = False
.Label2.BackColor = RGB(0, 96, 0)
.Label2.Left = 30
.Label2.Caption = InpTitle
.Label1.Font = InpFont
.Label2.Font = InpFont
.Command2.Font = InpFont
.Command3.Font = InpFont
.Label1.Width = 3100
.Label1.Caption = InpPrompt
If .Label1.Height <= 720 Then
InpObj.Move InpX, InpY, .Label1.Width + 1485, 1680
.Image1.Top = 405
Else
InpObj.Move InpX, InpY, .Label1.Width + 1485, .Label1.Height + 900
.Image1.Top = .Label1.Top + (.Label1.Height / 2) - 480
End If
If InpObj.Width < 5010 Then InpObj.Width = 5010
.Text1.Top = InpObj.Height - 450
.Command3.Top = InpObj.Height - 345
.Command2.Top = InpObj.Height - 645
.Command3.Left = InpObj.Width - 1140
.Command2.Left = InpObj.Width - 1140
.Image1.Left = InpObj.Width - 915
.Label2.Width = InpObj.Width - 75
.Command1.Left = InpObj.Width - 360
InpObj.Line (0, 0)-(InpObj.Width - 15, InpObj.Height - 15), RGB(128, 128, 128), B
InpObj.Line (15, 15)-(InpObj.Width - 15, 15), RGB(255, 255, 255)
InpObj.Line (15, 15)-(15, InpObj.Height - 15), RGB(255, 255, 255)
InpObj.Line (15, InpObj.Height - 30)-(InpObj.Width - 30, InpObj.Height - 30), RGB(128, 128, 128)
InpObj.Line (InpObj.Width - 30, 30)-(InpObj.Width - 30, InpObj.Height - 30), RGB(128, 128, 128)
.Text1.Text = Inp
.Text1.SelStart = 0
.Text1.SelLength = Len(Inp)
InpForm1.Show 1
End With
End Sub
Public Sub ColBar(Obj As Object, St%, H%, R%, G%, B%, RE%, GE%, BE%)
Dim H2%, H3%, IvR%, IvG%, IvB%
Obj.AutoRedraw = True
Obj.ScaleMode = 3 'pixel
H3 = Int(H / 2)
IvR = Int(RE - R) / H3
IvG = Int(GE - G) / H3
IvB = Int(BE - B) / H3
Do While H >= H3
Obj.Line (0, St + H2)-(Obj.ScaleWidth, St + H2), RGB(R, G, B)
Obj.Line (0, St + H)-(Obj.ScaleWidth, St + H), RGB(R, G, B)
H = H - 1
H2 = H2 + 1
R = R + IvR
G = G + IvG
B = B + IvB
Loop
End Sub